home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / ppfont10 / ppfontnm.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-05-08  |  3.0 KB  |  95 lines
  1. VERSION 2.00
  2. Begin Form fontform 
  3.    Caption         =   "PPFont Demo"
  4.    ClientHeight    =   3900
  5.    ClientLeft      =   1620
  6.    ClientTop       =   1545
  7.    ClientWidth     =   5745
  8.    Height          =   4305
  9.    Left            =   1560
  10.    LinkTopic       =   "Form2"
  11.    ScaleHeight     =   3900
  12.    ScaleWidth      =   5745
  13.    Top             =   1200
  14.    Width           =   5865
  15.    Begin ListBox List2 
  16.       Height          =   1395
  17.       Left            =   3960
  18.       TabIndex        =   1
  19.       Top             =   600
  20.       Width           =   1575
  21.    End
  22.    Begin ListBox List1 
  23.       Height          =   3150
  24.       Left            =   180
  25.       Sorted          =   -1  'True
  26.       TabIndex        =   0
  27.       Top             =   600
  28.       Width           =   3615
  29.    End
  30.    Begin Label Label2 
  31.       Alignment       =   2  'Center
  32.       Caption         =   "True Type Full Names"
  33.       Height          =   435
  34.       Left            =   4200
  35.       TabIndex        =   3
  36.       Top             =   120
  37.       Width           =   1155
  38.    End
  39.    Begin Label Label1 
  40.       Caption         =   "Family"
  41.       Height          =   315
  42.       Left            =   180
  43.       TabIndex        =   2
  44.       Top             =   300
  45.       Width           =   1515
  46.    End
  47. Declare Function PPFontFamNames Lib "PPFONT.DLL" (ByVal hwnd As Integer, afn As lfFaceName, aft As Integer) As Integer
  48. Declare Function PPFontFamNum Lib "PPFONT.DLL" (ByVal hwnd As Integer) As Integer
  49. Declare Function PPFontNames Lib "PPFONT.DLL" (ByVal hwnd As Integer, afn As lfFullName, aft As Integer, ByVal afamily As String) As Integer
  50. Declare Function PPFontNum Lib "PPFONT.DLL" (ByVal hwnd As Integer, ByVal afamily As String) As Integer
  51. Sub Form_Load ()
  52.     Static ftype() As Integer
  53.     Static lf() As lfFaceName
  54.     n = PPFontFamNum(hwnd)
  55.     ReDim lf(n), ftype(n)
  56.     i = PPFontFamNames(hwnd, lf(1), ftype(1))
  57.     For j = 1 To i
  58.         ft$ = "Vector"
  59.         If ftype(j) And TRUETYPE_FONTTYPE Then
  60.            ft$ = "TrueType"
  61.         Else
  62.            If ftype(j) And RASTER_FONTTYPE Then
  63.               ft$ = "Raster"
  64.            End If
  65.         End If
  66.         font$ = lf(j).FaceName
  67.         For k = 1 To LF_FACESIZE
  68.             If Asc(Mid$(font$, k, 1)) = 0 Then
  69.                Exit For
  70.             End If
  71.         Next
  72.         font$ = Mid$(font$, 1, k - 1)
  73.         l = Len(ft$)
  74.         list1.AddItem font$ + "   * " + ft$
  75.     Next
  76.     list1.ListIndex = 4
  77.     list1_click
  78. End Sub
  79. Sub list1_click ()
  80.     Static lf() As lfFullName
  81.     Static ftype() As Integer
  82.     list2.Clear
  83.     selfont$ = list1.List(list1.ListIndex)
  84.     n = InStr(selfont$, "*")
  85.     selfont$ = Trim(Mid$(selfont$, 1, n - 4))
  86.     n = PPFontNum(hwnd, selfont$)
  87.     ReDim lf(n), ftype(n)
  88.     i = PPFontNames(hwnd, lf(1), ftype(1), selfont$)
  89.     If ftype(1) And TRUETYPE_FONTTYPE Then
  90.        For j = 1 To i
  91.            list2.AddItem lf(j).FullName
  92.        Next
  93.     End If
  94. End Sub
  95.